home *** CD-ROM | disk | FTP | other *** search
/ Cracking 1 / Cracking I..iso / Tools / Ostatní / aPLib v0.26b / examples / delphi / t_main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-12-15  |  2.7 KB  |  125 lines
  1. unit t_main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   aPLib, ExtCtrls, StdCtrls, ComCtrls;
  8.  
  9. type
  10.   TfrmMain = class(TForm)
  11.     aPLib: TaPLib;
  12.     Button1: TButton;
  13.     Button2: TButton;
  14.     Panel1: TPanel;
  15.     OD: TOpenDialog;
  16.     GroupBox1: TGroupBox;
  17.     PB: TProgressBar;
  18.     Label3: TLabel;
  19.     Label4: TLabel;
  20.     Label1: TLabel;
  21.     Label2: TLabel;
  22.     Label5: TLabel;
  23.     CancelBtn: TButton;
  24.     procedure Button1Click(Sender: TObject);
  25.     procedure Button2Click(Sender: TObject);
  26.     procedure CancelBtnClick(Sender: TObject);
  27.   private
  28.     { Private declarations }
  29.   public
  30.     Cancel   : Boolean;
  31.     FileSize : DWORD;
  32.   end;
  33.  
  34.   function CallBack(w1, w2 : DWORD) : DWORD;cdecl;
  35.  
  36. var
  37.   frmMain: TfrmMain;
  38.  
  39. implementation
  40.  
  41. {$R *.DFM}
  42.  
  43. function CallBack(w1, w2 : DWORD) : DWORD;
  44. begin
  45.   with frmMain do
  46.   begin
  47.     Label4.Caption := FormatFloat('##%', ((FileSize - (w1-w2))/FileSize) * 100);
  48.     PB.Position    := Round(w1/FileSize*100);
  49.  
  50.     Application.ProcessMessages;
  51.  
  52.     if Cancel then Result := aP_pack_break
  53.               else Result := aP_pack_continue;
  54.   end;
  55. end;
  56.  
  57. procedure TfrmMain.Button1Click(Sender: TObject);
  58. var
  59.   FileIn,
  60.   FileOut : TFileStream;
  61.   Buffer  : Pointer;
  62. begin
  63.   if not OD.Execute then Exit;
  64.  
  65.   FileIn := TFileStream.Create(OD.FileName,fmOpenRead or fmShareDenyWrite);
  66.   GetMem(Buffer, FileIn.Size);
  67.   FileIn.Read(Buffer^, FileIn.Size);
  68.  
  69.   aPLib.Source   := Buffer;
  70.   aPLib.Length   := FileIn.Size;
  71.  
  72.   aPlib.CallBack := @CallBack;
  73.  
  74.   FileSize          := FileIn.Size;
  75.   Cancel            := False;
  76.   CancelBtn.Enabled := True;
  77.  
  78.   aPLib.Pack;
  79.  
  80.   FileIn.Destroy;
  81.  
  82.   if aPLib.Length = 0 then Exit;
  83.  
  84.   FileOut := TFileStream.Create(ExtractFilePath(OD.FileName)+'out.pak', fmCreate);
  85.   FileOut.Write(aPLib.Destination^, aPLib.Length);
  86.   FileOut.Destroy;
  87.  
  88.   CancelBtn.Enabled := False;
  89.  
  90.   ShowMessage('Packed file name is out.pak !');
  91.  
  92. end;
  93.  
  94. procedure TfrmMain.Button2Click(Sender: TObject);
  95. var
  96.   FileIn,
  97.   FileOut : TFileStream;
  98.   Buffer  : Pointer;
  99.  
  100. begin
  101.   if not OD.Execute then Exit;
  102.  
  103.   FileIn := TFileStream.Create(OD.FileName,fmOpenRead or fmShareDenyWrite);
  104.   GetMem(Buffer, FileIn.Size);
  105.   FileIn.Read(Buffer^, FileIn.Size);
  106.  
  107.   aPLib.Source   := Buffer;
  108.   aPLib.Length   := FileIn.Size;
  109.   aPLib.DePack;
  110.  
  111.   FileOut := TFileStream.Create(ExtractFilePath(OD.FileName)+'out.nor', fmCreate or fmOpenWrite);
  112.   FileOut.Write(aPLib.Destination^, aPLib.Length);
  113.   FileOut.Destroy;
  114.   FileIn.Destroy;
  115.  
  116.   ShowMessage('Original file name is out.nor !');
  117. end;
  118.  
  119. procedure TfrmMain.CancelBtnClick(Sender: TObject);
  120. begin
  121.   Cancel := True;
  122. end;
  123.  
  124. end.
  125.